home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Surface1.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-21  |  11KB  |  368 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSurface1 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Surface1"
  6.    ClientHeight    =   5295
  7.    ClientLeft      =   300
  8.    ClientTop       =   570
  9.    ClientWidth     =   9135
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   5295
  24.    ScaleWidth      =   9135
  25.    Begin VB.OptionButton optSurface 
  26.       Caption         =   "Volcano"
  27.       Height          =   255
  28.       Index           =   13
  29.       Left            =   0
  30.       TabIndex        =   14
  31.       Top             =   4680
  32.       Width           =   2055
  33.    End
  34.    Begin VB.OptionButton optSurface 
  35.       Caption         =   "Pit"
  36.       Height          =   255
  37.       Index           =   12
  38.       Left            =   0
  39.       TabIndex        =   13
  40.       Top             =   4320
  41.       Width           =   2055
  42.    End
  43.    Begin VB.OptionButton optSurface 
  44.       Caption         =   "Canyons"
  45.       Height          =   255
  46.       Index           =   11
  47.       Left            =   0
  48.       TabIndex        =   12
  49.       Top             =   3960
  50.       Width           =   2055
  51.    End
  52.    Begin VB.OptionButton optSurface 
  53.       Caption         =   "Hill and Hole"
  54.       Height          =   255
  55.       Index           =   10
  56.       Left            =   0
  57.       TabIndex        =   11
  58.       Top             =   3600
  59.       Width           =   2055
  60.    End
  61.    Begin VB.OptionButton optSurface 
  62.       Caption         =   "Monkey Saddle"
  63.       Height          =   255
  64.       Index           =   9
  65.       Left            =   0
  66.       TabIndex        =   10
  67.       Top             =   3240
  68.       Width           =   2055
  69.    End
  70.    Begin VB.OptionButton optSurface 
  71.       Caption         =   "Splash"
  72.       Height          =   255
  73.       Index           =   0
  74.       Left            =   0
  75.       TabIndex        =   9
  76.       Top             =   0
  77.       Value           =   -1  'True
  78.       Width           =   2055
  79.    End
  80.    Begin VB.OptionButton optSurface 
  81.       Caption         =   "Mounds"
  82.       Height          =   255
  83.       Index           =   1
  84.       Left            =   0
  85.       TabIndex        =   8
  86.       Top             =   360
  87.       Width           =   2055
  88.    End
  89.    Begin VB.OptionButton optSurface 
  90.       Caption         =   "Bowl"
  91.       Height          =   255
  92.       Index           =   2
  93.       Left            =   0
  94.       TabIndex        =   7
  95.       Top             =   720
  96.       Width           =   2055
  97.    End
  98.    Begin VB.OptionButton optSurface 
  99.       Caption         =   "Ridges"
  100.       Height          =   255
  101.       Index           =   3
  102.       Left            =   0
  103.       TabIndex        =   6
  104.       Top             =   1080
  105.       Width           =   2055
  106.    End
  107.    Begin VB.OptionButton optSurface 
  108.       Caption         =   "Randomized Ridges"
  109.       Height          =   255
  110.       Index           =   4
  111.       Left            =   0
  112.       TabIndex        =   5
  113.       Top             =   1440
  114.       Width           =   2055
  115.    End
  116.    Begin VB.OptionButton optSurface 
  117.       Caption         =   "Hemisphere"
  118.       Height          =   255
  119.       Index           =   5
  120.       Left            =   0
  121.       TabIndex        =   4
  122.       Top             =   1800
  123.       Width           =   2055
  124.    End
  125.    Begin VB.OptionButton optSurface 
  126.       Caption         =   "Holes"
  127.       Height          =   255
  128.       Index           =   6
  129.       Left            =   0
  130.       TabIndex        =   3
  131.       Top             =   2160
  132.       Width           =   2055
  133.    End
  134.    Begin VB.OptionButton optSurface 
  135.       Caption         =   "Cone"
  136.       Height          =   255
  137.       Index           =   7
  138.       Left            =   0
  139.       TabIndex        =   2
  140.       Top             =   2520
  141.       Width           =   2055
  142.    End
  143.    Begin VB.OptionButton optSurface 
  144.       Caption         =   "Saddle"
  145.       Height          =   255
  146.       Index           =   8
  147.       Left            =   0
  148.       TabIndex        =   1
  149.       Top             =   2880
  150.       Width           =   2055
  151.    End
  152.    Begin VB.PictureBox picCanvas 
  153.       AutoRedraw      =   -1  'True
  154.       Height          =   5295
  155.       Left            =   2160
  156.       ScaleHeight     =   349
  157.       ScaleMode       =   3  'Pixel
  158.       ScaleWidth      =   461
  159.       TabIndex        =   0
  160.       Top             =   0
  161.       Width           =   6975
  162.    End
  163. Attribute VB_Name = "frmSurface1"
  164. Attribute VB_GlobalNameSpace = False
  165. Attribute VB_Creatable = False
  166. Attribute VB_PredeclaredId = True
  167. Attribute VB_Exposed = False
  168. Option Explicit
  169. ' Location of viewing eye.
  170. Private EyeR As Single
  171. Private EyeTheta As Single
  172. Private EyePhi As Single
  173. Private Const Dtheta = PI / 20
  174. Private Const Dphi = PI / 20
  175. Private Const Dr = 1
  176. ' Location of focus point.
  177. Private Const FocusX = 0#
  178. Private Const FocusY = 0#
  179. Private Const FocusZ = 0#
  180. Private Projector(1 To 4, 1 To 4) As Single
  181. Private TheGrid As Grid3d
  182. Private Enum SurfaceTypes
  183.     surface_Splash = 0
  184.     surface_Mounds = 1
  185.     surface_Bowl = 2
  186.     surface_Ridges = 3
  187.     surface_RandomRidges = 4
  188.     surface_Hemisphere = 5
  189.     surface_Holes = 6
  190.     surface_Cone = 7
  191.     surface_Saddle = 8
  192.     surface_MonkeySaddle = 9
  193.     surface_HillAndHole = 10
  194.     surface_Canyons = 11
  195.     surface_Pit = 12
  196.     surface_Volcano = 13
  197. End Enum
  198. Private SelectedSurface As SurfaceTypes
  199. Private SphereRadius As Single
  200. Private Const Amplitude1 = 0.25
  201. Private Const Period1 = 2 * PI / 4
  202. Private Const Amplitude2 = 1
  203. Private Const Period2 = 2 * PI / 16
  204. Private Const Amplitude3 = 2
  205. Private Const Xmin = -5
  206. Private Const Zmin = -5
  207. ' Return the Y coordinate for these X and
  208. ' Z coordinates.
  209. Private Function YValue(ByVal X As Single, ByVal Z As Single)
  210. Dim x1 As Single
  211. Dim z1 As Single
  212. Dim x2 As Single
  213. Dim z2 As Single
  214. Dim D As Single
  215.     Select Case SelectedSurface
  216.         Case surface_Splash
  217.             D = Sqr(X * X + Z * Z)
  218.             YValue = Amplitude1 * Cos(3 * D)
  219.         Case surface_Mounds
  220.             YValue = Amplitude1 * (Cos(Period1 * X) + Cos(Period1 * Z))
  221.         Case surface_Bowl
  222.             YValue = 0.2 * (X * X + Z * Z) - 5#
  223.         Case surface_Ridges
  224.             YValue = Amplitude2 * Cos(Period2 * X) + Amplitude3 * Cos(Period1 * Z) / (Abs(Z) / 3 + 1)
  225.         Case surface_RandomRidges
  226.             YValue = Amplitude2 * Cos(Period2 * X) + Amplitude3 * Cos(Period1 * Z) / (Abs(Z) / 3 + 1) + Amplitude1 * Rnd
  227.         Case surface_Hemisphere
  228.             D = X * X + Z * Z
  229.             If D >= SphereRadius Then
  230.                 YValue = 0
  231.             Else
  232.                 YValue = Sqr(SphereRadius - D)
  233.             End If
  234.         Case surface_Holes
  235.             x1 = (X + Xmin / 2)
  236.             z1 = (Z + Xmin / 2)
  237.             x2 = (X - Xmin / 2)
  238.             z2 = (Z - Xmin / 2)
  239.             YValue = Amplitude3 - _
  240.                 1 / (x1 * x1 + z1 * z1 + 0.1) - _
  241.                 1 / (x2 * x2 + z1 * z1 + 0.1) - _
  242.                 1 / (x1 * x1 + z2 * z2 + 0.1) - _
  243.                 1 / (x2 * x2 + z2 * z2 + 0.1)
  244.         Case surface_Cone
  245.             D = 2 * (Amplitude3 - Sqr(X * X + Z * Z))
  246.             If D < -Amplitude3 Then D = -Amplitude3
  247.             YValue = D
  248.         Case surface_Saddle
  249.             YValue = (X * X - Z * Z) / 10
  250.         Case surface_MonkeySaddle
  251.             x1 = 1.5 * X
  252.             z1 = 1.5 * Z
  253.             YValue = (x1 * x1 * x1 / 3 - x1 * z1 * z1) / 50
  254.         Case surface_HillAndHole
  255.             YValue = -5 * X / (X * X + Z * Z + 1)
  256.         Case surface_Canyons
  257.             YValue = Sin(X * 1.5) * Z * Z * Z / 30
  258.         Case surface_Pit
  259.             YValue = -3 + (X * X + Z * Z) / 10 + Sin(2 * Sqr(X * X + Z * Z)) / 2
  260.         Case surface_Volcano
  261.             YValue = -Abs(X * X + Z * Z - 9) / 10
  262.     End Select
  263. End Function
  264. ' Project and display the data.
  265. Private Sub DrawData(pic As Object)
  266. Dim X As Single
  267. Dim Y As Single
  268. Dim Z As Single
  269. Dim S(1 To 4, 1 To 4) As Single
  270. Dim T(1 To 4, 1 To 4) As Single
  271. Dim ST(1 To 4, 1 To 4) As Single
  272. Dim PST(1 To 4, 1 To 4) As Single
  273.     MousePointer = vbHourglass
  274.     Refresh
  275.     ' Make the data.
  276.     CreateData
  277.     ' Scale and translate so it looks OK in pixels.
  278.     m3Scale S, 35, -35, 1
  279.     m3Translate T, 230, 175, 0
  280.     m3MatMultiplyFull ST, S, T
  281.     m3MatMultiplyFull PST, Projector, ST
  282.     ' Transform the points.
  283.     TheGrid.ApplyFull PST
  284.     ' Prevent overflow errors when drawing lines
  285.     ' too far out of bounds.
  286.     On Error Resume Next
  287.     ' Display the data.
  288.     pic.Cls
  289.     TheGrid.Draw pic
  290.     pic.Refresh
  291.     MousePointer = vbDefault
  292.     picCanvas.SetFocus
  293. End Sub
  294. Private Sub optSurface_Click(Index As Integer)
  295.     SelectedSurface = Index
  296.     DrawData picCanvas
  297. End Sub
  298. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  299.     Select Case KeyCode
  300.         Case vbKeyLeft
  301.             EyeTheta = EyeTheta - Dtheta
  302.         
  303.         Case vbKeyRight
  304.             EyeTheta = EyeTheta + Dtheta
  305.         
  306.         Case vbKeyUp
  307.             EyePhi = EyePhi - Dphi
  308.         
  309.         Case vbKeyDown
  310.             EyePhi = EyePhi + Dphi
  311.                 
  312.         Case Else
  313.             Exit Sub
  314.     End Select
  315.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  316.     DrawData picCanvas
  317. End Sub
  318. Private Sub Form_KeyPress(KeyAscii As Integer)
  319.     Select Case KeyAscii
  320.         Case Asc("+")
  321.             EyeR = EyeR + Dr
  322.         
  323.         Case Asc("-")
  324.             EyeR = EyeR - Dr
  325.         
  326.         Case Else
  327.             Exit Sub
  328.     End Select
  329.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  330.     DrawData picCanvas
  331. End Sub
  332. Private Sub Form_Load()
  333.     ' Initialize the eye position.
  334.     EyeR = 10
  335.     EyeTheta = PI * 0.2
  336.     EyePhi = PI * 0.1
  337.     ' Initialize the projection transformation.
  338.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  339.     ' Project and draw the data.
  340.     Me.Show
  341.     DrawData picCanvas
  342. End Sub
  343. ' Create the surface.
  344. Private Sub CreateData()
  345. Const Dx = 0.3
  346. Const Dz = 0.3
  347. Const NumX = -2 * Xmin / Dx
  348. Const NumZ = -2 * Zmin / Dz
  349. Dim i As Integer
  350. Dim j As Integer
  351. Dim X As Single
  352. Dim Y As Single
  353. Dim Z As Single
  354.     SphereRadius = (Xmin + 3 * Dx) * (Xmin + 3 * Dx)
  355.     Set TheGrid = New Grid3d
  356.     TheGrid.SetBounds Xmin, Dx, NumX, Zmin, Dz, NumZ
  357.     X = Xmin
  358.     For i = 1 To NumX
  359.         Z = Zmin
  360.         For j = 1 To NumZ
  361.             Y = YValue(X, Z)
  362.             TheGrid.SetValue X, Y, Z
  363.             Z = Z + Dz
  364.         Next j
  365.         X = X + Dx
  366.     Next i
  367. End Sub
  368.